home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / NUMBERS.SWG / 0019_ROMAN1.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  82 lines
  1. {
  2. ·    Subject: Word to Roman Numeral
  3.  
  4.   OK, here is my second attempt, With error checking and all. Thanks to
  5. Terry Moore <T.Moore@massey.ac.nz> For encouraging me. The last Function
  6. also contained a couple of errors. This one is errorchecked.
  7. }
  8.  
  9. Function RomantoArabic(Roman : String) : Integer;
  10. { Converts a Roman number to its Integer representation }
  11. { Returns -1 if anything is wrong }
  12.  
  13.   Function Valueof(ch : Char) : Integer;
  14.   begin
  15.     Case ch of
  16.       'I' : Valueof:=1;
  17.       'V' : Valueof:=5;
  18.       'X' : Valueof:=10;
  19.       'L' : Valueof:=50;
  20.       'C' : Valueof:=100;
  21.       'D' : Valueof:=500;
  22.       'M' : Valueof:=1000;
  23.       else Valueof:=-1;
  24.     end;
  25.   end;   { Valueof }
  26.  
  27.   Function AFive(ch : Char) : Boolean; { Returns True if ch = 5,50,500 }
  28.   begin
  29.     AFive:=ch in ['V','L','D'];
  30.   end;   { AFive }
  31.  
  32. Var
  33.   Position : Byte;
  34.   TheValue, CurrentValue : Integer;
  35.   HighestPreviousValue : Integer;
  36. begin
  37.   Position:=Length(Roman); { Initialize all Variables }
  38.   TheValue:=0;
  39.   HighestPreviousValue:=Valueof(Roman [Position]);
  40.   While Position > 0 do
  41.   begin
  42.     CurrentValue:=Valueof(Roman [Position]);
  43.     if CurrentValue<0 then
  44.     begin
  45.       RomantoArabic:=-1;
  46.       Exit;
  47.     end;
  48.     if CurrentValue >= HighestPreviousValue then
  49.     begin
  50.       TheValue:=TheValue+CurrentValue;
  51.       HighestPreviousValue:=CurrentValue;
  52.     end
  53.     else
  54.     begin { if the digit precedes something larger }
  55.       if AFive(Roman [Position]) then
  56.       begin
  57.               RomantoArabic:=-1; { A five digit can't precede anything }
  58.               Exit;
  59.       end;
  60.       if HighestPreviousValue div CurrentValue > 10 then
  61.       begin
  62.               RomantoArabic:=-1; { e.g. 'XM', 'IC', 'XD'... }
  63.               Exit;
  64.       end;
  65.       TheValue:=TheValue-CurrentValue;
  66.     end;
  67.     Dec(Position);
  68.   end;
  69.   RomantoArabic:=TheValue;
  70. end;   { RomantoArabic }
  71.  
  72. begin
  73.   Writeln('XXIV = ', RomantoArabic('XXIV'));
  74.   Writeln('DXIV = ', RomantoArabic('DXIV'));
  75.   Writeln('CXIV = ', RomantoArabic('CXIV'));
  76.   Writeln('MIXC = ', RomantoArabic('MIXC'));
  77.   Writeln('MXCIX = ', RomantoArabic('MXCIX'));
  78.   Writeln('LXVIII = ', RomantoArabic('LXVIII'));
  79.   Writeln('MCCXXIV = ', RomantoArabic('MCCXXIV'));
  80.   Writeln('MMCXLVI = ', RomantoArabic('MMCXLVI'));
  81.   Readln;
  82. end.